home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / Umrandung / Umrandung.P
Text File  |  1997-05-06  |  2KB  |  82 lines
  1. PROGRAM Umrandung2;
  2.  
  3. { Eine Umrandungsvariante, die statt mit Intuition- mit Graphikelementen
  4.   arbeitet und dabei mehr Varianten eröffnet, wie z.B. dickere und
  5.   unterschiedliche X- und Y-Rahmen.
  6.  
  7.   written 1992 by Andreas Neumann of NEUDELSoft                          }
  8.  
  9. {$I "Include:Intuition/Intuition.i" }
  10. {$I "Include:Graphics/Graphics.i" }
  11. {$I "Include:Graphics/Pens.i" }
  12. {$I "Include:Exec/Ports.i" }
  13. {$I "Include:Exec/Libraries.i" }
  14.  
  15. CONST
  16.         wintitle : String = ("Tolle Effekte mit der Procedure 'Umrandung'");
  17.  
  18.         MyNewWindow : NewWindow = (0,0,640,200,-1,-1,
  19.                                    CLOSEWINDOW_f,
  20.                                    ACTIVATE +SMART_REFRESH+
  21.                                    WINDOWCLOSE+RMBTRAP,
  22.                                    NIL,NIL,wintitle,NIL,NIL,0,0,0,0,
  23.                                    WBENCHSCREEN_f);
  24.  
  25.         gfxname : String = ("graphics.library");
  26.  
  27. VAR
  28.     imes : IntuiMessagePtr;
  29.     win  : WindowPtr;
  30.  
  31. PROCEDURE Line (w : WindowPtr; x1 , y1 , x2 , y2 , col : Short);
  32.  
  33. BEGIN
  34.  SetAPen (w^.RPort,col);
  35.  Move (w^.RPort,x1,y1);
  36.  Draw (w^.RPort,x2,y2);
  37. END;
  38.  
  39. PROCEDURE Umrandung (wo : WindowPtr; c1,c2,x,y,b,h,xstaerke,ystaerke : SHORT);
  40.  
  41. VAR um1 : Short;
  42.  
  43. BEGIN
  44.  FOR um1:=0 TO xstaerke DO
  45.  BEGIN
  46.   Line (wo,x+um1,y+um1,x+um1,y+h-1-um1,c1);
  47.   Line (wo,x+b-1-um1,y+um1,x+b-1-um1,y+h-1-um1,c2);
  48.  END;
  49.  FOR um1:=0 TO ystaerke DO
  50.  BEGIN
  51.   Line (wo,x+um1,y+um1,x+b-1-um1,y+um1,c1);
  52.   Line (wo,x+um1,y+h-1-um1,x+b-1-um1,y+h-1-um1,c2);
  53.  END;
  54.  
  55. END;
  56.  
  57.  
  58. BEGIN
  59.  GfxBase := OpenLibrary (gfxname,0);
  60.  win:=OpenWindow (Adr(MyNewWindow));
  61.  
  62.  IF win<>NIL THEN
  63.  BEGIN
  64.  
  65.   Umrandung(win,2,1,10,15,620,180,1,1);
  66.   Umrandung(win,1,2,20,20,200,100,1,1);
  67.   Umrandung(win,2,1,250,20,200,100,1,1);
  68.   Umrandung(win,2,1,260,30,150,40,1,1);
  69.   Umrandung(win,2,1,280,80,100,20,1,1);
  70.   Umrandung(win,1,2,278,79,104,22,1,1);
  71.   Umrandung(win,1,2,270,40,50,20,1,1);
  72.  
  73.   imes:=Address(WaitPort(win^.UserPort));
  74.   imes:=Address(GetMsg(win^.UserPort));
  75.   ReplyMsg(Address(imes));
  76.   CloseWindow(win);
  77.  END;
  78.  
  79.  CloseLibrary (GfxBase);
  80. END.
  81.  
  82.